VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsActiveX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-----------------------------------------------------------------
'             PT DC Hub @ Direct Connect P2P Network
'-----------------------------------------------------------------
'       Developer: Carlos.DF (fLaSh) - Portugal
'          E-mail: carlosferreiracarlos@hotmail.com
' Project started: 10 - September - 2006
'         License: GNU General Public License.
'-----------------------------------------------------------------
'       Thanks to developers and contributores of SDCH/DDCH
'         The Left Hand, ButterflySoul, HaArD and Selyb
'  TheNOP, RollTheDice, JDommi, GhOstFaCE, ArchaicLight and TUFF
'-----------------------------------------------------------------
Option Explicit

Private Declare Function LoadTypeLib Lib "oleaut32.dll" (pFileName As Byte, pptlib As Object) As Long
Private Declare Function RegisterTypeLib Lib "oleaut32.dll" (ByVal ptlib As Object, szFullPath As Byte, szHelpFile As Byte) As Long
Private Declare Function UnRegisterTypeLib Lib "oleaut32.dll" (libID As GUID, ByVal wVerMajor As Integer, ByVal wVerMinor As Integer, ByVal lCID As Long, ByVal tSysKind As eSYSKIND) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (lpsz As Byte, pclsid As GUID) As Long

Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lParameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Enum eSYSKIND
   SYS_WIN16 = 0&
   SYS_WIN32 = 1&
   SYS_MAC = 2&
End Enum

Public Enum RegOp
    Register = 1
    UnRegister = 0
End Enum

Public Function RegisterActiveX(ByRef sDllPah As String, ByRef iRegOption As RegOp) As Boolean
1:    Dim lngDllProcAddress   As Long
2:    Dim lngExitCode         As Long
3:    Dim lngThreadID         As Long
4:    Dim varThread           As Variant
5:    Dim lngLib              As Long
6:    Dim lngWait             As Long

8:    On Error GoTo Err

10:    lngLib = LoadLibrary(sDllPah)

12:    If lngLib = 0 Then RegisterActiveX = False: Exit Function

14:    If iRegOption = Register Then
15:        lngDllProcAddress = GetProcAddress(lngLib, "DllRegisterServer")
16:    Else
17:        lngDllProcAddress = GetProcAddress(lngLib, "DllUnregisterServer")
18:    End If
    
20:    If lngDllProcAddress = 0 Then
21:        RegisterActiveX = False
22:        Exit Function
23:    Else
24:        varThread = CreateThread(ByVal 0, 0, ByVal lngDllProcAddress, ByVal 0, 0, lngThreadID)
25:        If varThread = 0 Then
26:            FreeLibrary lngLib
27:            RegisterActiveX = False
28:            Exit Function
29:        Else
30:            lngWait = WaitForSingleObject(varThread, 10000)
31:            If lngWait <> 0 Then
32:                FreeLibrary lngLib
33:                lngExitCode = GetExitCodeThread(varThread, lngExitCode)
34:                ExitThread lngExitCode
35:                Exit Function
36:            Else
37:                FreeLibrary lngLib
38:                CloseHandle varThread
39:            End If
40:        End If
41:    End If
    
43:    RegisterActiveX = True
    
45:    Exit Function
46:
Err:
47:    HandleError Err.Number, Err.Description, Erl & "|" & "clsActiveX.RegisterActiveX()"
End Function

Public Function RegisterTBL(ByRef sLib As String) As Boolean
1:    Dim suLib() As Byte
2:    Dim lErrOK As Long
3:    Dim tlb As Object
4:    On Error GoTo Err

      'Basic automatically translates strings to Unicode Byte arrays
      'but doesn't null-terminate, so you must do it yourself
8:    suLib = sLib & vbNullChar

      'Pass first byte of array
11:   lErrOK = LoadTypeLib(suLib(0), tlb)

12:   'DoEvents

'13:   If lErrOK = 0 Then
14:        lErrOK = RegisterTypeLib(tlb, suLib(0), 0)
'15:   End If

17:   RegisterTBL = CBool(lErrOK = 0)
      
21:   Exit Function

23:
Err:
25:   HandleError Err.Number, Err.Description, Erl & "|" & "clsActiveX.RegisterTypeLib(" & sLib & ")"
End Function

Public Function GetWindowsDir() As String
1:    Dim strBruffer As String
2:    On Error GoTo Err

4:    strBruffer = String(200, Chr$(0))
    
6:    GetWindowsDir = CStr(Left$(strBruffer, GetWindowsDirectory(strBruffer, Len(strBruffer))))

8:    Exit Function

10:
Err:
11:   GetWindowsDir = Empty
12:   HandleError Err.Number, Err.Description, Erl & "|" & "clsActiveX.GetWindowsDir()"
End Function
